rm(list=ls())

Libraries

library(ComputationalMovementAnalysisData)  # Wild Boar Data 
library(tidyverse)                          # dplyr, ggplot, etc.
library(sf)                                 # spatial data operations
library(tmap)                               # thematic maps for spatial vector data 
library(terra)                              # spatial raster and vector data operations
library(gridExtra)                          # functions to work with grids and their visualizations
library(data.table)                         # functions for easy handling of data frames
library(lubridate)                          # for easy handling of Datetimes
library(ggpubr)                             # for ggplot customizations
ws <- wildschwein_BE                        # complete Dataset of Wild Boar
metadata <- wildschwein_metadata            # Wild Boar metadata

underl_map <- terra::rast("pk100_BE.tif")   # underlay raster map of the region
names(ws)                                   # all column names
## [1] "TierID"          "TierName"        "CollarID"        "DatetimeUTC"    
## [5] "E"               "N"               "day"             "moonilumination"
# removing some unsused columns
ws <- ws %>% subset(select = - c(day, CollarID, moonilumination))

n_distinct(ws$TierID)                       # 19 Wild Boar
## [1] 19
# Adding "timelag" column - time between each sampling occasion
ws <- ws %>% 
  group_by(TierID) %>% 
  mutate(timelag = as.integer(difftime(lead(DatetimeUTC), DatetimeUTC, units = "secs"))) %>% 
  ungroup()

summary(ws$timelag)
##      Min.   1st Qu.    Median      Mean   3rd Qu.      Max.      NA's 
## -56815113       894       898      1074       905  49580106        19
# 19 NA's because of 19 distinct ID's

EDA (Exploratory Data Analysis)

Exploring Sampling Intervals and timing of samplings for each Wild Boar

ws$TierID <- as.factor(ws$TierID)

p1 <- ws %>% ggplot(aes(x = DatetimeUTC, y = TierID, colour = TierID)) +
  geom_point(show.legend = F)

p1  

range(ws$timelag, na.rm = T)    # range of values in timelag
## [1] -56815113  49580106
nrow(ws)                        # number of observations
## [1] 327255
# Filtering Rows with unreasonable values
ws_range <- ws %>% 
  filter(timelag >= 0 & timelag < 30000)
  

range(ws_range$timelag, na.rm = T)
## [1]    12 29840
nrow(ws_range)
## [1] 327208
nrow(ws) - nrow(ws_range)       # 47 values removed
## [1] 47

Histograms of sampling interval distribution

ws_range %>% 
  ggplot(aes(x = timelag)) +
  geom_histogram(binwidth = 60) +
  scale_y_log10()

# filtered for intervals between 0  and 2000 seconds 
ws_range2 <- ws_range %>% filter(timelag >= 0 & timelag < 2000)

ws_range2 %>% 
  ggplot(aes(x = timelag)) +
  geom_histogram(binwidth = 1) +
  scale_y_log10()    # logarithmic for better visualization of sampling intervals counts

-> most sampling intervals are between 10 & 20 minutes

# Count of 60 second sampling intervals
ws_60s <- ws_range %>% filter(timelag >= 40 & timelag < 70)

ws_60s %>% 
  ggplot(aes(x = timelag)) +
  geom_histogram(binwidth = 1) +
  scale_y_log10()
## Warning: Transformation introduced infinite values in continuous y-axis
## Warning: Removed 5 rows containing missing values (geom_bar).

-> around 30000 sampling intervals are within 1 minute

ws_60s <- ws_60s %>% filter(DatetimeUTC > "2015-01-01" & DatetimeUTC < "2016-01-01")

p3 <- ws_60s %>% ggplot(aes(x = DatetimeUTC, y = TierID, colour = TierID)) +
  geom_point(show.legend = F)

p3

-> Animal ID’s c(10, 22, 36, 40, 48) have sampling intervals of one minute in overlapping times in the year 2015

# Names of the animals we are interested in, based on their 60 seconds intervals in sampling
ws_names <- unique(ws_60s$TierName)

Pre-Analysis of Location

sf_60s <- st_as_sf(ws_60s, coords = c("E","N"), crs = 2056)

sf_60s_grouped <- group_by(sf_60s, TierID)
sf_60s_smry <- summarise(sf_60s_grouped)
mcp <- st_convex_hull(sf_60s_smry)
ggplot(mcp, ) + 
    aes(fill = TierID, alpha = 0.5) +
    geom_sf() +
    coord_sf(datum = sf::st_crs(2056))

-> Overlapping convex-hulls, except Wild Boar with ID 48. Also, sizes apparently differ among sexes (40 & 48 are males).

Transforming to SF object and adding Sex to data set from metadata

ws <- merge(ws, metadata[, c("TierID","Sex")], by = "TierID")

ws_sf <- st_as_sf(ws,
                coords = c("E", "N"), 
                crs = 2056)

ws_sf$TierID <- as.factor(ws_sf$TierID)
ws_grp <- ws_sf %>% group_by(TierID)

Plotting Convex Hull’s of Males and females separately

# ws_grp -> is a grouped sf object containing all individuals
# m_grp -> just males
# f_grp -> just females

m_grp <- ws_grp %>% filter(Sex == "m")
f_grp <- ws_grp %>% filter(Sex == "f")

m_smry <- summarise(m_grp)
f_smry <- summarise(f_grp)

m_mcp <- st_convex_hull(m_smry)
f_mcp <- st_convex_hull(f_smry)
tmap_mode("view") # open in viewer for interactive map
## tmap mode set to interactive viewing
#males
mcp_males <- tm_shape(underl_map) + 
              tm_rgb() +
              tm_shape(m_mcp) +
              tm_polygons("TierID", alpha = 0.5, border.col = "red", legend.show = FALSE)

mcp_males
## stars object downsampled to 1129 by 886 cells. See tm_shape manual (argument raster.downsample)
#females
mcp_females <- tm_shape(underl_map) + 
                tm_rgb() +
                tm_shape(f_mcp) +
                tm_polygons("TierID", alpha = 0.5, border.col = "red", legend.show = FALSE)

mcp_females
## stars object downsampled to 1129 by 886 cells. See tm_shape manual (argument raster.downsample)

-> females very overlapping, however, time of sampling differs -> males seem to have larger mcp’s -> all mcp’s are covering the main forest patch near the lake

Territorial Analysis

Research Question:

Can we identify (core) territories of individual Wild Boar in their resting/sleeping sites and feeding grounds?

Hypothesis

We expect that we can at least to some extent identify core territories. Given that, we further expect that these territories differ in size between the resting sites (the forest patch) and the feeding grounds (agricultural sites), and among sexes.

# removing all the data form memory
rm(list=ls())
# reloading the Wild Boar data
ws <- wildschwein_BE                        # complete Dataset of Wild Boar
metadata <- wildschwein_metadata            # Wild Boar metadata

underl_map <- terra::rast("pk100_BE.tif")   # underlay raster map of the region

# Loading and preparing Forest Polygon
st_layers("Feldaufnahmen_Fanel.gpkg")
## Driver: GPKG 
## Available layers:
##            layer_name geometry_type features fields
## 1 Feldaufnahmen_Fanel       Polygon      975      2
forest <- read_sf("Feldaufnahmen_Fanel.gpkg")
forest <- forest %>% filter(Frucht == "Wald")

Data Preparation

# adding Sex and Study_area from metadata to the data set, removing unused columns
ws <- merge(ws, metadata[, c("TierID","Sex")], by = "TierID")
ws <- merge(ws, metadata[, c("TierID","Study_area")], by = "TierID")
ws <- ws %>% subset(select = - c(CollarID, day, moonilumination))

ws_fin <- ws %>% 
  filter(Study_area == "Bern")
# apparently, complete data set already only containing animals from the Bernese study area

# removing this variable and column "study_area" again
rm(ws_fin)
ws <- ws %>%  subset(select = - c(Study_area))
# Focusing only on these 5 individuals having a sampling interval of 60 seconds
ws <- ws %>% filter(TierID %in% c(10, 22, 36, 40, 48)) 
ws_sf <- st_as_sf(ws,
                coords = c("E", "N"), 
                crs = 2056)

# ws_sf_nonfactor <- ws_sf
ws_sf$TierID <- as.factor(ws_sf$TierID)

Territorial Analysis using the “aggregate” function

Function to produce an occurence plot using a grid structure with aggregate.

Applicable to any Wild Boar in the Data set and can also handle multiple (or all) animals as inputs, producing a list of plots. After applying the function, these can either be arranged to be viewed and compared together, or each plot can separately be extracted from the plot list.

grid_agg_plots <- function(data, underl_map, Cellsize){
  
  # get ID's in input data and produce an empty list
  id_list <- unique(data$TierID)
  plot_list <- vector("list", length(id_list))
  
  data <- group_by(data, TierID)
  
  for (i in seq(1,length(id_list))){
    # extracting data of the animal with certain animal ID:
    ws_temp <- filter(data, TierID == id_list[i])
    
    # constructing the Grid by the outermost points of the animal in question
    grid_area <- st_make_grid(ws_temp, square = FALSE, cellsize = Cellsize, crs = 2056) %>% st_as_sf()
    
    # aggregating the gps points to each grid cell
    grid_agg <- aggregate(x = ws_temp, by = grid_area, FUN = length) %>% select(TierID)
    
    # producing the plot
    p <-  tm_shape(underl_map) +
                      tm_rgb() +
                      tm_shape(grid_agg) +
                      tm_polygons("TierID", alpha = 0.7, style="cont", legend.show = TRUE) +
                      tm_layout(legend.outside = TRUE)
      
    # creating variable & append to plot list
    var_name <- paste("P", id_list[i], sep = "")
    
    # appending to plot list
    plot_list[[i]] <- assign(var_name, p)
    
  }
  return(plot_list)
}

running the function on all individuals with 60 second sampling interval in one plot

plots <- grid_agg_plots(ws_sf, underl_map, 150)

Plot all individuals with 60 second sampling interval in one plot

# may need to adjust size of plot

tmap_mode("plot")           # mode to view plot in plot instead of viewer

Arranged_plots <- tmap_arrange(plots, ncol = 2)   # arranging the plots next to each other
Arranged_plots

-> plot representing absolute number of gps points in each grid cell for each animal -> plots are in order: first plot (top left) = animal with ID 10 second plot (top right) = animal with ID 22 and so on… couldn’t figure out how to name the plots

plot animals with ID’s: 22 (Miriam) & 36 (Olga) (both females)

ws_females    <- ws_sf %>% filter(TierID %in% c(22,36))
plots_females <- grid_agg_plots(ws_females, underl_map, 150)
arr_females   <- tmap_arrange(plots_females, ncol = 1)
arr_females

plot animals with ID’s: 40 (Franz) & 36 (Amos) (both males)

ws_males      <- ws_sf %>% filter(TierID %in% c(40,48))
plots_males   <- grid_agg_plots(ws_males  , underl_map, 150)
arr_males     <- tmap_arrange(plots_males  , ncol = 1)
arr_males

Territorial Analysis using the “st_join” function -> keeping much more information and seems to be “the way to go”

Function to produce an occurence plot using a grid structure with st_join.

Big advantage of this method compared to using “aggregate”, is that we can recover a lot of information that would get lost in the aggregate function. Here, we did it in a way so we can keep information about Animal ID. Later, in the section about “Recurrence”, we are able to keep information about datetime and additional logical information to construct recurrences to a specific cell in the grid using the st_join method.

Applicable to any Wild Boar in the Data set and can also handle multiple (or all) animals as inputs, producing a list of plots. After applying the function, these can either be arranged to be viewed and compared together, or each plot can separately be extracted from the plot list.

grid_join_plots <- function(data, underl_map, Cellsize){

  # get ID's in input data and produce an empty list
  id_list <- unique(data$TierID)
  plot_list <- vector("list", length(id_list))
  
  data <- group_by(data, TierID)
  
  for (i in seq(1,length(id_list))){
    
    # extracting data of the animal with certain animal ID:
    ws_temp <- filter(data, TierID == id_list[i]) %>% select(DatetimeUTC, TierID)
    
    # constructing the Grid by the outermost points of the animal in question
    grid_area <- st_make_grid(ws_temp, square = FALSE, cellsize = Cellsize, crs = 2056) %>% st_as_sf()
    
    # Adding unique ID to each cell in the grid
    grid_area <- grid_area %>% mutate(ID = row_number())
    
    # join all data points to each grid cell
    grid_agg <- st_join(ws_temp, grid_area, left = FALSE)
    
    # get number of occurrences in each grid cell
    by_cell <- grid_agg %>% group_by(ID,TierID) %>% summarise(n = n())
    
    # join information in each grid cell to the grid by joining the cell ID's
    new_agg <- st_join(grid_area, by_cell)
    
    # produce individual plot 
    p <-  tm_shape(underl_map) +
                      tm_rgb() +
                      tm_shape(new_agg) +
                      tm_polygons("n", alpha = 0.8, style = "cont", legend.show = TRUE) +
                      tm_layout(legend.outside = TRUE)

    # creating variable & append to plot list
    var_name <- paste("P", id_list[i], sep = "")

    # appending to plot list
    plot_list[[i]] <- assign(var_name, p)

  }
  return(plot_list)
  # return(grid_agg)
}

running the function on all individuals with 60 second sampling interval in one plot

plots <- grid_join_plots(ws_sf, underl_map, 150)
## `summarise()` has grouped output by 'ID'. You can override using the `.groups`
## argument.
## `summarise()` has grouped output by 'ID'. You can override using the `.groups`
## argument.
## `summarise()` has grouped output by 'ID'. You can override using the `.groups`
## argument.
## `summarise()` has grouped output by 'ID'. You can override using the `.groups`
## argument.
## `summarise()` has grouped output by 'ID'. You can override using the `.groups`
## argument.

Plot all individuals with 60 second sampling interval in one plot

# may need to adjust size of plot

tmap_mode("plot")           # mode to view plot in plot instead of viewer

Arranged_plots <- tmap_arrange(plots, ncol = 2)   # arranging the plots next to each other
Arranged_plots

-> plot representing absolute number of gps points in each grid cell for each animal -> plots are in order: first plot (top left) = animal with ID 10 second plot (top right) = animal with ID 22 and so on… couldn’t figure out how to name the plots

Function to produce an occurence plot containing multiple layers using a grid structure with st_join.

occur_layer_plot <- function(data, Cellsize){
  
  # constructing the Grid by the outermost points of the animal in question
  grid_area <- st_make_grid(data, square = FALSE, cellsize = Cellsize) %>%  st_as_sf()
  
  # Adding unique ID to each cell in the grid
  grid_area <- grid_area %>% mutate(ID = row_number())

  # join all data points to each grid cell
  grid_agg <- st_join(data, grid_area, left = FALSE)

  # get number of occurrences in each grid cell
  by_cell <- grid_agg %>% group_by(ID,TierID) %>% summarise(n = n())
  
  # join information in each grid cell to the grid by joining the cell ID's and drop NA, which deletes the rest of the grid
  new_agg <- st_join(grid_area, by_cell, by = ID) %>% drop_na()
  
  # return cell-wise information to be plotted afterwards
  return(new_agg)
}
# Filtering each individual
ws_Caroline <- ws_sf %>% filter(TierID == 10)
ws_Miriam   <- ws_sf %>% filter(TierID == 22)
ws_Olga     <- ws_sf %>% filter(TierID == 36)
ws_Franz    <- ws_sf %>% filter(TierID == 40)
ws_Amos     <- ws_sf %>% filter(TierID == 48)

# Applying function
Caroline  <- occur_layer_plot(ws_Caroline, 150)
## `summarise()` has grouped output by 'ID'. You can override using the `.groups`
## argument.
Miriam    <- occur_layer_plot(ws_Miriam, 150)
## `summarise()` has grouped output by 'ID'. You can override using the `.groups`
## argument.
Olga      <- occur_layer_plot(ws_Olga, 150)
## `summarise()` has grouped output by 'ID'. You can override using the `.groups`
## argument.
Franz     <- occur_layer_plot(ws_Franz, 150)
## `summarise()` has grouped output by 'ID'. You can override using the `.groups`
## argument.
Amos      <- occur_layer_plot(ws_Amos, 150)
## `summarise()` has grouped output by 'ID'. You can override using the `.groups`
## argument.

Occurence plot containing layers for all 5 individuals

tmap_mode("view")
## tmap mode set to interactive viewing
All_inds <- tm_shape(underl_map) +
                tm_rgb() +
              tm_shape(Caroline) +
                tm_polygons("n", alpha = 0.8, style = "cont", palette = "Blues", n = 30) +
                tm_layout(legend.show = FALSE)  +
              tm_shape(Miriam) +
                tm_polygons("n", alpha = 0.8, style = "cont", palette = "Reds", n = 30) +
                tm_layout(legend.show = FALSE)  +
              tm_shape(Olga) +
                tm_polygons("n", alpha = 0.8, style = "cont", palette = "Greens", n = 30) +
                tm_layout(legend.show = FALSE)  +
              tm_shape(Franz) +
                tm_polygons("n", alpha = 0.8, style = "cont", palette = "Purples", n = 30) +
                tm_layout(legend.show = FALSE)  +
              tm_shape(Amos) +
                tm_polygons("n", alpha = 0.8, style = "cont", palette = "PuRd", n = 30) +
                tm_layout(legend.show = FALSE)
All_inds
## stars object downsampled to 1129 by 886 cells. See tm_shape manual (argument raster.downsample)

Analysis of recurrences to each grid cell by an individual wild boar.

This is giving us another information about the territory of an individual, as we can see which cells were repeatedly visited and seem to represent the main sleeping (in resting territories) and feeding (in the feeding grounds) territories of the wild boar.

Function to produce recurrence plots containing a layer for each individual

Applicable to any Wild Boar in the Data set, but needs to be done for every individual separately. After applying the function, the output will be a data frame containing information about all points within each cell and corresponding animal ID, so that it can afterwards be plotted with a layer for each animal of interest.

recurr_layer_plot <- function(data, Cellsize){
  
  # constructing the Grid by the outermost points of the animal in question
  grid_area <- st_make_grid(data, square = FALSE, cellsize = Cellsize) %>%  st_as_sf()
  
  # Adding unique ID to each cell in the grid
  grid_area <- grid_area %>% mutate(ID = row_number())

  # join all data points to each grid cell
  grid_agg <- st_join(data, grid_area, left = FALSE)

  # get number of reccurrences to each grid cell
  by_cell <- grid_agg %>% mutate(logic = ifelse(ID == lag(ID), TRUE, FALSE)) %>% group_by(ID) %>% count(logic) %>% filter(logic == FALSE)

  # join information in each grid cell to the grid by joining the cell ID's and drop NA, which deletes the rest of the grid
  new_agg <- st_join(grid_area, by_cell, by = ID) %>% drop_na()
  
  # return cell-wise information to be plotted afterwards
  return(new_agg)
}

plot animals with ID’s: 22 (Miriam, Blue) & 36 (Olga, Red) (both females)

ws_sf_miriam <- ws_sf %>% filter(TierID %in% c(22)) %>% select(DatetimeUTC, TierID)
Miriam <- recurr_layer_plot(ws_sf_miriam, 100)

ws_sf_olga <- ws_sf %>% filter(TierID %in% c(36)) %>% select(DatetimeUTC, TierID)
Olga <- recurr_layer_plot(ws_sf_olga, 100)
tmap_mode("view")
## tmap mode set to interactive viewing
MO <- tm_shape(underl_map) +
        tm_rgb() +
        tm_shape(Miriam) +
        tm_polygons("n", alpha = 0.8, style = "cont", palette = "Blues", n = 30) +
        tm_layout(legend.show = FALSE)  +
        tm_shape(Olga) +
        tm_polygons("n", alpha = 0.8, style = "cont", palette = "Reds", n = 30) +
        tm_layout(legend.show = FALSE)

MO
## stars object downsampled to 1129 by 886 cells. See tm_shape manual (argument raster.downsample)

plot animals with ID’s: 40 (Franz, Blue) & 36 (Amos, Red) (both males)

ws_sf_franz <- ws_sf %>% filter(TierID %in% c(40)) %>% select(DatetimeUTC, TierID)
Franz <- recurr_layer_plot(ws_sf_franz, 100)

ws_sf_amos <- ws_sf %>% filter(TierID %in% c(48)) %>% select(DatetimeUTC, TierID)
Amos <- recurr_layer_plot(ws_sf_amos, 100)
FA <- tm_shape(underl_map) +
        tm_rgb() +
        tm_shape(Franz) +
        tm_polygons("n", alpha = 0.8, style = "cont", palette = "Blues", n = 30) +
        tm_layout(legend.show = FALSE)  +
        tm_shape(Amos) +
        tm_polygons("n", alpha = 0.8, style = "cont", palette = "Reds", n = 30) +
        tm_layout(legend.show = FALSE)

FA
## stars object downsampled to 1129 by 886 cells. See tm_shape manual (argument raster.downsample)

Separating Forest habitat and feeding grounds

Here, applied only to absolute occurrences for now, but would be also applicable to recurrences

forest_separation_fun <- function(data, Cellsize, forest_polygon){
  
  # constructing the Grid by the outermost points of the animal in question
  grid_area <- st_make_grid(data, square = FALSE, cellsize = Cellsize) %>%  st_as_sf()
  
  # returns True/False for points in forest
  intersects <- st_intersects(grid_area,  forest)
  
  # Additional column in grid_area with T/F for Forest
  grid_area$forest <- sapply(intersects, FUN = length) > 0
  
  # Adding unique ID to each cell in the grid
  grid_area <- grid_area %>% mutate(ID = row_number())
  
  # join all data points to each grid cell
  grid_agg <- st_join(data, grid_area, left = FALSE)

  # get number of occurrences in each grid cell and group by forest
  by_cell <- grid_agg %>% group_by(ID, forest) %>% summarise(n = n())

  # join information in each grid cell to the grid by joining the cell ID's and drop NA, which deletes the rest of the grid
  new_agg <- st_join(grid_area, by_cell) %>% drop_na()
  
  # return cell-wise information to be plotted afterwards
  return(new_agg)
  
}

Example plot for wild boar Olga

# selecting Olga (36)
ws_sf_olga <- ws_sf %>% filter(TierID %in% c(36)) %>% select(DatetimeUTC, TierID)

# applying function
agg_olga <- forest_separation_fun(ws_sf_olga, 150, forest)
## `summarise()` has grouped output by 'ID'. You can override using the `.groups`
## argument.
# splitting forsest and non_forest
agg_olga_forest     <- agg_olga %>% filter(forest.x == TRUE) %>% drop_na()
agg_olga_non_forest <- agg_olga %>% filter(forest.x == FALSE) %>% drop_na()
Olga_forest <- tm_shape(underl_map) +
                  tm_rgb() +
                  tm_shape(agg_olga_forest) +
                  tm_polygons("n", alpha = 0.8, style = "cont", n = 30, palette = "Greens", n = 100, contrast = c(0.35, 0.9)) +
                  tm_borders(col = "black", lwd = 1, lty = "solid") +
                  tm_shape(agg_olga_non_forest) +
                  tm_polygons("n", alpha = 0.8, style = "cont", n = 30, palette = "Reds", n = 100, contrast = c(0.35, 0.9)) +
                  tm_layout(legend.outside = TRUE)

Olga_forest
## stars object downsampled to 1129 by 886 cells. See tm_shape manual (argument raster.downsample)
## Warning: One tm layer group has duplicated layer types, which are omitted. To
## draw multiple layers of the same type, use multiple layer groups (i.e. specify
## tm_shape prior to each of them).

Analysis of Meeting occasions and trajectories before and after such an event

Research Question

Hypothesis

# removing all the data form memory
rm(list=ls())
# reloading the Wild Boar data
ws <- wildschwein_BE                        # complete Dataset of Wild Boar
metadata <- wildschwein_metadata            # Wild Boar metadata
# adding Sex and Study_area from metadata to the data set, removing unused columns
ws <- merge(ws, metadata[, c("TierID","Sex")], by = "TierID")
ws <- merge(ws, metadata[, c("TierID","Study_area")], by = "TierID")
ws <- ws %>% subset(select = - c(CollarID, day, moonilumination))

# Adding "timelag" column - time between each sampling occasion
ws <- ws %>% 
  group_by(TierID) %>% 
  mutate(timelag = as.integer(difftime(lead(DatetimeUTC), DatetimeUTC, units = "secs"))) %>% 
  ungroup()

# Focusing only on these 5 individuals having a sampling interval of 60 seconds
ws <- ws %>% filter(TierID %in% c(10, 22, 36, 40, 48)) 

# rounding datetime to minutes for easier detection of meetups
ws <- ws %>% mutate(dt_rounded = round_date(DatetimeUTC, unit = "minute"))

# filter to 60 seconds interval
ws <- ws %>% filter(timelag >= 50 & timelag < 70)

(Here it is missing how we detected which animals meet, i don’t know how you did it. I guess visually between each parir of individuals?)

Visualization of meet-ups between Caroline and Olga

# filtering for Miriam and Olga
ws_caroline <- ws %>% filter(TierID == 10)
ws_olga     <- ws %>% filter(TierID == 36)

# joining the data of Olga and Miriam and detect meet ups by a threshold of 30 meters
ws_caroline_olga_join <- inner_join(ws_caroline, ws_olga, by = "dt_rounded", suffix = c("_caroline", "_olga")) %>% 
                 mutate(distance = sqrt((E_caroline - E_olga)^2 + (N_caroline - N_olga)^2), meet = distance < 30)

Plot to visualize points of meet-ups

ggplot() +
  geom_point(data = ws_caroline, aes(x = E, y = N, color = TierName),  alpha = 0.1, size = 0.5) +
  geom_point(data = ws_olga, aes(x = E, y = N, color = TierName), alpha = 0.1, size = 0.5) +
  geom_point(data = ws_caroline_olga_join %>%  filter(meet == TRUE), aes(x = E_caroline, y = N_caroline, fill = TierName_caroline), pch = 21, color = "black") +
  geom_point(data = ws_caroline_olga_join %>%  filter(meet == TRUE), aes(x = E_olga, y = N_olga, fill = TierName_olga), pch = 21, color = "black")

Plotting Trajectories before and after meet-up (+/- 6 minutes)

# extracting the points before and after meet-up (+/- 6 minutes)
ws_caroline_olga_join <- ws_caroline_olga_join %>% mutate(
  #
  mMinus6 = shift(meet, 6, type = "lead"),
  mMinus5 = shift(meet, 5, type = "lead"),
  mMinus4 = shift(meet, 4, type = "lead"),
  mMinus3 = shift(meet, 3, type = "lead"),
  mMinus2 = shift(meet, 2, type = "lead"),
  mMinus1 = shift(meet, 1, type = "lead"),
  mPlus1  = shift(meet, 1, type = "lag"),
  mPlus2  = shift(meet, 2, type = "lag"),
  mPlus3  = shift(meet, 3, type = "lag"),
  mPlus4  = shift(meet, 4, type = "lag"),
  mPlus5  = shift(meet, 5, type = "lag"),
  mPlus6  = shift(meet, 6, type = "lag"),
  #
)

# filtering for all points, where at least one of the columns for +/- 6 minutes contains a TRUE
meet_traj <- ws_caroline_olga_join %>% filter( mMinus6 + mMinus5 + mMinus4 + mMinus3 + mMinus2 + mMinus1 + 
                                                 mPlus1 + mPlus2 + mPlus3 + mPlus4 + mPlus5 + mPlus6  >  0)

# setting session timezone to UTC (doesn't work otherwise)
Sys.setenv(TZ = "UTC")

# splitting up each meeting occasion
occasion1 <- meet_traj %>% filter(dt_rounded > "2015-09-20 05:00:00 UTC" & dt_rounded < "2015-09-20 06:00:00 UTC")
occasion2 <- meet_traj %>% filter(dt_rounded > "2015-09-20 18:00:00 UTC" & dt_rounded < "2015-09-20 21:00:00 UTC")
occasion3 <- meet_traj %>% filter(dt_rounded > "2015-09-20 19:00:00 UTC" & dt_rounded < "2015-09-20 20:00:00 UTC")

# resetting session timezone
Sys.setenv(TZ = "")

Plots

# Occasion 1
ggplot(data = occasion1) +
  geom_path(aes(x = E_caroline, y = N_caroline, fill = TierName_caroline), color = "red") +
  geom_path(aes(x = E_olga, y = N_olga, fill = TierName_olga), color = "cyan") +
  geom_point(aes(x = E_caroline, y = N_caroline, fill = TierName_caroline), pch = 21, color = "black") +
  geom_point(aes(x = E_olga, y = N_olga, fill = TierName_olga), pch = 21, color = "black") +
  geom_text(aes(x = E_caroline, y = N_caroline, label = rownames(occasion1)), nudge_x = -0.5, nudge_y = 4, check_overlap = TRUE, color = "darkred") +
  geom_text(aes(x = E_olga, y = N_olga, label = rownames(occasion1)), nudge_x = -0.5, nudge_y = -4, check_overlap = TRUE, color = "darkblue")
## Warning: Ignoring unknown aesthetics: fill
## Ignoring unknown aesthetics: fill

# Occasion 2
ggplot(data = occasion2) +
  geom_path(aes(x = E_caroline, y = N_caroline, fill = TierName_caroline), color = "red") +
  geom_path(aes(x = E_olga, y = N_olga, fill = TierName_olga), color = "cyan") +
  geom_point(aes(x = E_caroline, y = N_caroline, fill = TierName_caroline), pch = 21, color = "black") +
  geom_point(aes(x = E_olga, y = N_olga, fill = TierName_olga), pch = 21, color = "black") +
  geom_text(aes(x = E_caroline, y = N_caroline, label = rownames(occasion2)), nudge_x = 2, nudge_y = 2, check_overlap = TRUE, color = "darkred") +
  geom_text(aes(x = E_olga, y = N_olga, label = rownames(occasion2)), nudge_x = -5, nudge_y = 2, check_overlap = TRUE, color = "darkblue")
## Warning: Ignoring unknown aesthetics: fill
## Ignoring unknown aesthetics: fill

# Occasion 3
ggplot(data = occasion3) +
  geom_path(aes(x = E_caroline, y = N_caroline, fill = TierName_caroline), color = "red") +
  geom_path(aes(x = E_olga, y = N_olga, fill = TierName_olga), color = "cyan") +
  geom_point(aes(x = E_caroline, y = N_caroline, fill = TierName_caroline), pch = 21, color = "black") +
  geom_point(aes(x = E_olga, y = N_olga, fill = TierName_olga), pch = 21, color = "black") +
  geom_text(aes(x = E_caroline, y = N_caroline, label = rownames(occasion3)), nudge_x = 0.5, nudge_y = 3, check_overlap = TRUE, color = "darkred") +
  geom_text(aes(x = E_olga, y = N_olga, label = rownames(occasion3)), nudge_x = -2, nudge_y = 2, check_overlap = TRUE, color = "darkblue")
## Warning: Ignoring unknown aesthetics: fill
## Ignoring unknown aesthetics: fill

-> we see around the middle numbers where they are closest to each other. However, as these two females seem to spend some minitues in close proximity, it looks like there is either no aggression or these two animals know and tolerate each other. ?? We assume that these females are not in the same family, as we saw in the territorial analysis, that they seem to have a different territory.